home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / CorePackages / aecoerce.tcl < prev    next >
Encoding:
Text File  |  2000-11-02  |  6.4 KB  |  180 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  TclAE - Coersion functions for AEGizmo values
  4.  # 
  5.  #  FILE: "aecoerce.tcl"
  6.  #                                    created: 11/18/98 {11:15:36 PM} 
  7.  #                                last update: 11/2/00 {8:30:08 AM} 
  8.  #                                    version: 2.0
  9.  #  Author: Jonathan Guyer
  10.  #  E-mail: jguyer@his.com
  11.  #    mail: Alpha Cabal
  12.  #          POMODORO no seisan
  13.  #     www: http://www.his.com/jguyer/
  14.  #  
  15.  # ========================================================================
  16.  #               Copyright (c) 1998-2000 Jonathan Guyer
  17.  #                         All rights reserved
  18.  # ========================================================================
  19.  # Permission to use, copy, modify, and distribute this software and its
  20.  # documentation for any purpose and without fee is hereby granted,
  21.  # provided that the above copyright notice appear in all copies and that
  22.  # both that the copyright notice and warranty disclaimer appear in
  23.  # supporting documentation.
  24.  # 
  25.  # Jonathan Guyer disclaims all warranties with regard to this software,
  26.  # including all implied warranties of merchantability and fitness.  In
  27.  # no event shall Jonathan Guyer be liable for any special, indirect or
  28.  # consequential damages or any damages whatsoever resulting from loss of
  29.  # use, data or profits, whether in an action of contract, negligence or
  30.  # other tortuous action, arising out of or in connection with the use or
  31.  # performance of this software.
  32.  # ========================================================================
  33.  #  Description: 
  34.  # 
  35.  #  History
  36.  # 
  37.  #  modified   by  rev reason
  38.  #  ---------- --- --- -----------
  39.  #  1998-11-18 JEG 1.0 original
  40.  # ###################################################################
  41.  ##
  42.  
  43. namespace eval tclAE::coerce {}
  44.  
  45. proc tclAE::coerce {} {}
  46.  
  47. proc tclAE::coerce::identity {typeCode data toType resultDesc} {
  48.     tclAE::replaceDescData $resultDesc $toType $data
  49. }
  50.  
  51. proc tclAE::coerce::true>bool {typeCode data toType resultDesc} {
  52.     tclAE::replaceDescData $resultDesc $toType [binary format c 1]
  53. }
  54.  
  55. proc tclAE::coerce::fals>bool {typeCode data toType resultDesc} {
  56.     tclAE::replaceDescData $resultDesc $toType [binary format c 0]
  57. }
  58.  
  59. proc tclAE::coerce::bool>shor {typeCode data toType resultDesc} {
  60.     tclAE::replaceDescData $resultDesc $toType [coerce bool -x $data -x shor]
  61. }
  62.  
  63. proc tclAE::coerce::shor>long {typeCode data toType resultDesc} {
  64.     tclAE::replaceDescData $resultDesc $toType [coerce shor -x $data -x long]
  65. }
  66.  
  67. proc tclAE::coerce::long>shor {typeCode data toType resultDesc} {
  68.     tclAE::replaceDescData $resultDesc $toType [coerce long -x $data -x shor]
  69. }
  70.  
  71. proc tclAE::coerce::long>TEXT {typeCode data toType resultDesc} {
  72.     tclAE::replaceDescData $resultDesc $toType [coerce long -x $data -x TEXT]
  73. }
  74.  
  75. proc tclAE::coerce::shor>TEXT {typeCode data toType resultDesc} {
  76.     tclAE::replaceDescData $resultDesc $toType [coerce shor -x $data -x TEXT]
  77. }
  78.  
  79. proc tclAE::coerce::TEXT>long {typeCode data toType resultDesc} {
  80.     tclAE::replaceDescData $resultDesc $toType [coerce TEXT -x $data -x long]
  81. }
  82.  
  83. proc tclAE::coerce::TEXT>shor {typeCode data toType resultDesc} {
  84.     tclAE::replaceDescData $resultDesc $toType [coerce TEXT -x $data -x shor]
  85. }
  86.  
  87.  
  88. proc tclAE::coerce::alis>TEXT {typeCode data toType resultDesc} {
  89.     tclAE::replaceDescData $resultDesc TEXT \
  90.       [tclAE::build::resultData 'MACS' core getd \
  91.           ---- "obj {form:alis, want:cobj, from:'null'(), \
  92.             seld:[tclAE::build::coercion [tclAE::build::hexd $data] "alis"]
  93.         }" \
  94.         rtyp TEXT
  95.       ]
  96. }
  97.  
  98. proc tclAE::coerce::TEXT>alis {typeCode data toType resultDesc} {
  99.     tclAE::replaceDescData $resultDesc $toType [coerce TEXT -x $data -x alis]
  100. }
  101.  
  102. proc tclAE::coerce::fss>TEXT {typeCode data toType resultDesc} {
  103.     tclAE::replaceDescData $resultDesc $toType [specToPathName $data]
  104. }
  105.  
  106. proc tclAE::coerce::register {from to proc} {
  107.     tclAE::installCoercionHandler $from $to $proc
  108. }
  109.  
  110. proc tclAE::coerce::apply {AEDesc to {typed 0}} {
  111.     global tclAE::coerce::coercions tclAE::coerce::overrides tclAE::coerce::noCoerce
  112.     
  113.     set from [tclAE::desc::_getKey $AEDesc descriptorType]
  114.     set value [tclAE::desc::_getKey $AEDesc value]
  115.     
  116.     if {$from == "list"} {
  117.         set msg "Cannot coerce a list"
  118.         error $msg "" [list AECoerce 18 $msg]
  119.     } 
  120.     
  121.     # no need to do anything for an identity coercion
  122.     if {$from != $to} {        
  123.         set coerce [list $from $to]
  124.         
  125.         foreach noCoerce ${tclAE::coerce::noCoerce} {
  126.             if {[string match $noCoerce $coerce]} {
  127.                 # return what was sent
  128.                 return [list $from $value]
  129.             }     
  130.         }
  131.         
  132.         # coercion not blocked, so see if we know how to do it
  133.         if {[set i [lsearch -glob ${tclAE::coerce::overrides} [list $from $to *]]] != -1} {
  134.             set value [[lindex [lindex ${tclAE::coerce::overrides} $i] 2] $value]
  135.         } elseif {[set i [lsearch -glob ${tclAE::coerce::coercions} [list $from $to *]]] != -1} {
  136.             set value [[lindex [lindex ${tclAE::coerce::coercions} $i] 2] $value]
  137.         } else {
  138.             # -1700 is a coercion failure.
  139.             # That's not exactly what we want; coercion didn't
  140.             # fail, we just don't know how to do it.
  141.             set msg "Can't coerce '$from' to '$to'"
  142.             error $msg "" [list AECoerce 1700 $msg]
  143.         }
  144.     }
  145.     if {$typed} {
  146.         return [tclAE::desc::makeTypeValue $to $value]
  147.     } else {
  148.         return $value
  149.     } 
  150. }
  151.  
  152. # ◊◊◊◊ Default Coercions ◊◊◊◊ #
  153.  
  154. if {([info tclversion] < 8.0)
  155. ||    ![info exists tclAE_version] 
  156. ||  ($tclAE_version < 2.0)} {
  157.     
  158.     tclAE::installCoercionHandler "null" "TEXT" tclAE::coerce::null>TEXT
  159.     tclAE::installCoercionHandler "long" "TEXT" tclAE::coerce::long>TEXT
  160.     tclAE::installCoercionHandler "shor" "TEXT" tclAE::coerce::shor>TEXT
  161.     # used ?
  162.     tclAE::installCoercionHandler "hexd" "alis" tclAE::coerce::alis>TEXT
  163.     tclAE::installCoercionHandler "alis" "TEXT" tclAE::coerce::alis>TEXT
  164.     # used ?
  165.     tclAE::installCoercionHandler "fss " "TEXT" tclAE::coerce::fss>TEXT
  166.     tclAE::installCoercionHandler "TEXT" "alis" tclAE::coerce::TEXT>alis
  167.     tclAE::installCoercionHandler "TEXT" "long" tclAE::coerce::TEXT>long
  168.     tclAE::installCoercionHandler "TEXT" "shor" tclAE::coerce::TEXT>shor
  169.     tclAE::installCoercionHandler "shor" "long" tclAE::coerce::shor>long
  170.     tclAE::installCoercionHandler "long" "shor" tclAE::coerce::long>shor
  171.     tclAE::installCoercionHandler "enum" "type" tclAE::coerce::identity
  172.  
  173.     tclAE::installCoercionHandler "true" "bool" tclAE::coerce::true>bool
  174.     tclAE::installCoercionHandler "fals" "bool" tclAE::coerce::fals>bool
  175.     tclAE::installCoercionHandler "bool" "shor" tclAE::coerce::bool>shor
  176.     tclAE::installCoercionHandler "bool" "TEXT" tclAE::coerce::bool>shor
  177.  
  178.  
  179. }
  180.